{*
  Object Pascal simple abstract record manipulation routines
  @Author  Maciej Zagozda (1998-2008)
  @Licence Microsoft Reciprocal License (Ms-RL)
  @Website http://www.codeplex.com/intelitechdelphirtns/
  @Version 2008/04/20 Added documentation support
}


// record information holds a set of properties of a single database record
// properties can have different types
// maintains records' previous values
// maintains record's modified status

unit RecordRoutines;

interface

uses
  Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, StdCtrls, DB;

type

  TGeneralProperty = class
  private
    fName: AnsiString;
    fFieldName: AnsiString;
    fModified: Boolean;

  public
    constructor Create;
    destructor Destroy; virtual;
  published
    property Name: AnsiString read fName write fName;
    property FieldName: AnsiString read fFieldName write fFieldName;
    property Modified: Boolean read fModified write fModified;
  end;

  TBooleanProperty = class(TGeneralProperty)
  private
    fCurrentValue: Boolean;
    fOriginalValue: Boolean;

    procedure SetCurrentValue(Value: Boolean);
  public
    constructor Create; overload;
    constructor Create(const aName: AnsiString; const aValue: Boolean); overload;
    destructor Destroy; virtual;
  published
    property CurrentValue: Boolean read fCurrentValue write SetCurrentValue;
    property OriginalValue: Boolean read fOriginalValue;
  end;

  TFloatProperty = class(TGeneralProperty)
  private
    fCurrentValue: Single;
    fOriginalValue: Single;

    procedure SetCurrentValue(Value: Single);
  public
    constructor Create; overload;
    constructor Create(const aName: AnsiString; const aValue: Single); overload;
    destructor Destroy; virtual;
  published
    property CurrentValue: Single read fCurrentValue write SetCurrentValue;
    property OriginalValue: Single read fOriginalValue;
  end;


  TIntegerProperty = class(TGeneralProperty)
  private
    fCurrentValue: Longint;
    fOriginalValue: Longint;

    procedure SetCurrentValue(Value: Longint);
  public
    constructor Create; overload;
    constructor Create(const aName: AnsiString; const aValue: Longint); overload;
    destructor Destroy; virtual;
  published
    property CurrentValue: Longint read fCurrentValue write SetCurrentValue;
    property OriginalValue: Longint read fOriginalValue;
  end;

  TStringProperty = class(TGeneralProperty)
  private
    fCurrentValue: AnsiString;
    fOriginalValue: AnsiString;
    fCaseSensitive: Boolean;

    procedure SetCurrentValue(Value: AnsiString);
  public
    constructor Create; overload;
    constructor Create(const aName: AnsiString; const aValue: AnsiString; const IsCaseSensitive: Boolean = False ); overload;
    destructor Destroy; virtual;
  published
    property CurrentValue: AnsiString read fCurrentValue write SetCurrentValue;
    property OriginalValue: AnsiString read fOriginalValue;
  end;

type
  TRecordData = class(TObject)
  private
    fCount: Integer;
    fValues: TObjectList;
    fModified: Boolean;

    function CheckName(const aName: AnsiString): Boolean;
  public
    Fields: TObjectList;

    constructor Create;
    destructor Destroy;

    procedure Clear;
    function Load(aDataSet: TDataSet): Boolean;
    function Save(aDataSet: TDataSet): Boolean;

    function AddBoolean(const aName: AnsiString; const aField: AnsiString; const aValue: Boolean = False ): Boolean;
    function GetBoolean(const aName: AnsiString; aCurrent: Boolean = True): Boolean;
    function SetBoolean(const aName: AnsiString; const aValue: Boolean ): Boolean;

    function AddFloat(const aName: AnsiString; const aField: AnsiString; const aValue: Single = 0 ): Boolean;
    function GetFloat(const aName: AnsiString; aCurrent: Boolean = True): Single;
    function SetFloat(const aName: AnsiString; const aValue: Single ): Boolean;

    function AddInteger(const aName: AnsiString; const aField: AnsiString; const aValue: Integer = 0 ): Boolean;
    function GetInteger(const aName: AnsiString; aCurrent: Boolean = True): Longint;
    function SetInteger(const aName: AnsiString; const aValue: Integer ): Boolean;

    function AddString(const aName: AnsiString; const aField: AnsiString; const aValue: AnsiString = '' ): Boolean;
    function GetString(const aName: AnsiString; aCurrent: Boolean = True): AnsiString;
    function SetString(const aName: AnsiString; const aValue: AnsiString ): Boolean;

  published
    property Count: Integer read fCount;
    property Modified: Boolean read fModified;
  end;

implementation

{*******************************************************}

constructor TGeneralProperty.Create;
begin
  inherited;
end;

destructor TGeneralProperty.Destroy;
begin
  inherited;
end;

{*******************************************************}

constructor TBooleanProperty.Create;
begin
  inherited Create;
  fCurrentValue := False;
  fOriginalValue := False;
end;

constructor TBooleanProperty.Create(const aName: AnsiString; const aValue: Boolean );
begin
  inherited Create;
  fCurrentValue := aValue;
  fOriginalValue := aValue;
end;

destructor TBooleanProperty.Destroy;
begin
  inherited;
end;

procedure TBooleanProperty.SetCurrentValue(Value: Boolean);
var
  blnModified, blnRestored: Boolean;
begin
  blnModified := Value <> fCurrentValue;
  blnRestored := Value = fOriginalValue;

  if blnRestored then
  begin
    fCurrentValue := fOriginalValue;
    fModified := False;
  end
  else
  begin
    if blnModified then
    begin
      fOriginalValue := fCurrentValue;
      fCurrentValue := Value;
      fModified := True;                                                        
    end
    else
    begin
      // value not restored, unchanged, hence do nothing
    end;
  end;
end;

{*******************************************************}

constructor TFloatProperty.Create;
begin
  inherited Create;
  fCurrentValue := 0;
  fOriginalValue := 0;
end;

constructor TFloatProperty.Create(const aName: AnsiString; const aValue: Single );
begin
  inherited Create;
  fCurrentValue := aValue;
  fOriginalValue := aValue;
end;

destructor TFloatProperty.Destroy;
begin
  inherited;
end;

procedure TFloatProperty.SetCurrentValue(Value: Single);
var
  blnModified, blnRestored: Boolean;
begin
  blnModified := Value <> fCurrentValue;
  blnRestored := Value = fOriginalValue;

  if blnRestored then
  begin
    fCurrentValue := fOriginalValue;
    fModified := False;
  end
  else
  begin
    if blnModified then
    begin
      fOriginalValue := fCurrentValue;
      fCurrentValue := Value;
      fModified := True;
    end
    else
    begin
      // value not restored, unchanged, hence do nothing
    end;
  end;
end;

{*******************************************************}

constructor TIntegerProperty.Create;
begin
  inherited Create;
  fCurrentValue := 0;
  fOriginalValue := 0;
end;

constructor TIntegerProperty.Create(const aName: AnsiString; const aValue: Longint );
begin
  inherited Create;
  fCurrentValue := aValue;
  fOriginalValue := aValue;
end;

destructor TIntegerProperty.Destroy;
begin
  inherited;
end;

procedure TIntegerProperty.SetCurrentValue(Value: Longint);
var
  blnModified, blnRestored: Boolean;
begin
  blnModified := Value <> fCurrentValue;
  blnRestored := Value = fOriginalValue;

  if blnRestored then
  begin
    fCurrentValue := fOriginalValue;
    fModified := False;
  end
  else
  begin
    if blnModified then
    begin
      fOriginalValue := fCurrentValue;
      fCurrentValue := Value;
      fModified := True;
    end
    else
    begin
      // value not restored, unchanged, hence do nothing
    end;
  end;
end;

{*******************************************************}

constructor TStringProperty.Create;
begin
  inherited Create;
  fCaseSensitive := True;
  fCurrentValue := '';
  fOriginalValue := '';
end;

constructor TStringProperty.Create(const aName: AnsiString; const aValue: AnsiString; const IsCaseSensitive: Boolean = False );
begin
  inherited Create;
  fCaseSensitive := IsCaseSensitive;
  fCurrentValue := aValue;
  fOriginalValue := aValue;
end;

destructor TStringProperty.Destroy;
begin
  inherited;
end;

procedure TStringProperty.SetCurrentValue(Value: AnsiString);
var
  blnModified, blnRestored: Boolean;
begin
  if fCaseSensitive then
  begin
    blnModified := Value <> fCurrentValue;
    blnRestored := Value = fOriginalValue;
  end
  else
  begin
    blnModified := AnsiCompareText( Value, fCurrentValue ) <> 0;
    blnRestored := AnsiCompareText( Value, fOriginalValue ) = 0;
  end;//if

  if blnRestored then
  begin
    fCurrentValue := fOriginalValue;
    fModified := False;
  end
  else
  begin
    if blnModified then
    begin
      fOriginalValue := fCurrentValue;
      fCurrentValue := Value;
      fModified := True;
    end
    else
    begin
      // value not restored, unchanged, hence do nothing
    end;
  end;
end;

{*******************************************************}

constructor TRecordData.Create;
begin
  inherited Create;
  fModified := False;
  fValues.Clear;
  fCount := 0;
end;

destructor TRecordData.Destroy;
begin
  fValues.Clear;
  inherited Destroy;
end;

procedure TRecordData.Clear;
var
  intA: Integer;
begin
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TStringProperty then
    begin
      TStringProperty(Fields.Items[intA]).CurrentValue := '';
    end;//if
  end;
  fCount := 0;
end;

function TRecordData.CheckName(const aName: AnsiString): Boolean;
var
  intA: Integer;
  blnUnique: Boolean;
begin
  blnUnique := True;
  for intA := 0 to Fields.Count -1 do
  begin
    if AnsiCompareText( aName, TGeneralProperty(Fields[intA]).Name ) =0 then
    begin
      blnUnique := False;
    end;//if
  end;//for
  Result := blnUnique;
end;

function TRecordData.AddBoolean(const aName: AnsiString; const aField: AnsiString; const aValue: Boolean = False ): Boolean;
begin
  if CheckName(aName) then
  begin
    Fields.Add(TBooleanProperty.Create(aName, aValue ));
    Result := True;
  end
  else
  begin
    Result := False;
  end;//if
end;

function TRecordData.AddFloat(const aName: AnsiString; const aField: AnsiString; const aValue: Single = 0 ): Boolean;
begin
  if CheckName(aName) then
  begin
    Fields.Add(TFloatProperty.Create(aName, aValue));
    Result := True;
  end
  else
  begin
    Result := False;
  end;//if
end;

function TRecordData.AddInteger(const aName: AnsiString; const aField: AnsiString; const aValue: Longint = 0 ): Boolean;
begin
  if CheckName(aName) then
  begin
    Fields.Add(TIntegerProperty.Create(aName, aValue));
    Result := True;
  end
  else
  begin
    Result := False;
  end;//if
end;

function TRecordData.AddString(const aName: AnsiString; const aField: AnsiString; const aValue: AnsiString = '' ): Boolean;
begin
  if CheckName(aName) then
  begin
    Fields.Add(TStringProperty.Create(aName, aValue ));
    Result := True;
  end
  else
  begin
    Result := False;
  end;//if
end;

function TRecordData.GetBoolean(const aName: AnsiString; aCurrent: Boolean = True): Boolean;
var
  intA: Integer;
begin
  Result := False;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TBooleanProperty then
    begin
      if AnsiCompareText( TBooleanProperty(Fields.Items[intA]).Name, aName ) =0 then
      begin
        if aCurrent then
        begin
          Result := TBooleanProperty(Fields.Items[intA]).CurrentValue;
        end
        else
        begin
          Result := TBooleanProperty(Fields.Items[intA]).OriginalValue;
        end;//if
      end;//if
    end;//if
  end;//for
end;

function TRecordData.GetFloat(const aName: AnsiString; aCurrent: Boolean = True): Single;
var
  intA: Integer;
begin
  Result := 0;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TFloatProperty then
    begin
      if AnsiCompareText( TFloatProperty(Fields.Items[intA]).Name, aName ) =0 then
      begin
        if aCurrent then
        begin
          Result := TFloatProperty(Fields.Items[intA]).CurrentValue;
        end
        else
        begin
          Result := TFloatProperty(Fields.Items[intA]).OriginalValue;
        end;//if
      end;//if
    end;//if
  end;//for
end;

function TRecordData.GetInteger(const aName: AnsiString; aCurrent: Boolean = True): Longint;
var
  intA: Integer;
begin
  Result := 0;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TIntegerProperty then
    begin
      if AnsiCompareText( TIntegerProperty(Fields.Items[intA]).Name, aName ) =0 then
      begin
        if aCurrent then
        begin
          Result := TIntegerProperty(Fields.Items[intA]).CurrentValue;
        end
        else
        begin
          Result := TIntegerProperty(Fields.Items[intA]).OriginalValue;
        end;//if
      end;//if
    end;//if
  end;//for
end;

function TRecordData.GetString(const aName: AnsiString; aCurrent: Boolean = True): AnsiString;
var
  intA: Integer;
begin
  Result := '';
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TStringProperty then
    begin
      if AnsiCompareText( TStringProperty(Fields.Items[intA]).Name, aName ) =0 then
      begin
        if aCurrent then
        begin
          Result := TStringProperty(Fields.Items[intA]).CurrentValue;
        end
        else
        begin
          Result := TStringProperty(Fields.Items[intA]).OriginalValue;
        end;//if
      end;//if
    end;//if
  end;//for
end;

function TRecordData.SetBoolean(const aName: AnsiString; const aValue: Boolean): Boolean;
var
  intA: Integer;
  blnA: Boolean;
begin
  blnA := False;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TBooleanProperty then
    begin
      TBooleanProperty(Fields.Items[intA]).CurrentValue := aValue;
      blnA := True;
    end;//if
  end;//for

  Result := blnA;
end;

function TRecordData.SetFloat(const aName: AnsiString; const aValue: Single): Boolean;
var
  intA: Integer;
  blnA: Boolean;
begin
  blnA := False;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TFloatProperty then
    begin
      TFloatProperty(Fields.Items[intA]).CurrentValue := aValue;
      blnA := True;
    end;//if
  end;//for

  Result := blnA;
end;

function TRecordData.SetInteger(const aName: AnsiString; const aValue: Longint): Boolean;
var
  intA: Integer;
  blnA: Boolean;
begin
  blnA := False;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TIntegerProperty then
    begin
      TIntegerProperty(Fields.Items[intA]).CurrentValue := aValue;
      blnA := True;
    end;//if
  end;//for

  Result := blnA;
end;

function TRecordData.SetString(const aName: AnsiString; const aValue: AnsiString): Boolean;
var
  intA: Integer;
  blnA: Boolean;
begin
  blnA := False;
  for intA := 0 to Fields.Count -1 do
  begin
    if Fields.Items[intA] is TStringProperty then
    begin
      TStringProperty(Fields.Items[intA]).CurrentValue := aValue;
      blnA := True;
    end;//if
  end;//for

  Result := blnA;
end;


function TRecordData.Load(aDataSet: TDataSet): Boolean;
var
  intA: Integer;
begin
  with aDataSet do
  begin
    if not EOF and not BOF then
    begin
      for intA := 0 to Self.Fields.Count -1 do
      begin

        if Self.Fields[intA] is TBooleanProperty then
        begin
          with TBooleanProperty(Self.Fields[intA]) do
          begin
            CurrentValue := FieldByName(FieldName).AsBoolean;
          end;//with
        end;//if

        if Self.Fields[intA] is TFloatProperty then
        begin
          with TFloatProperty(Self.Fields[intA]) do
          begin
            CurrentValue := FieldByName(FieldName).AsFloat;
          end;//with
        end;//if

        if Self.Fields[intA] is TIntegerProperty then
        begin
          with TIntegerProperty(Self.Fields[intA]) do
          begin
            CurrentValue := FieldByName(FieldName).AsInteger;
          end;//with
        end;//if

        if Self.Fields[intA] is TStringProperty then
        begin
          with TStringProperty(Self.Fields[intA]) do
          begin
            CurrentValue := FieldByName(FieldName).AsString;
          end;//with
        end;//if

      end;
    end;//if
  end;//with
end;

function TRecordData.Save(aDataSet: TDataSet): Boolean;
var
  intA: Longint;
begin
  if ( aDataSet.State = dsInsert ) or ( aDataSet.State = dsEdit ) then
  begin
  end
  else
  begin
    aDataSet.Edit;
  end;//if

  with aDataSet do
  begin
    for intA := 0 to Self.Fields.Count -1 do
    begin

      if Self.Fields[intA] is TBooleanProperty then
      begin
        with TBooleanProperty(Self.Fields[intA]) do
        begin
          FieldByName(FieldName).AsBoolean := CurrentValue;
        end;//with
      end;//if

      if Self.Fields[intA] is TFloatProperty then
      begin
        with TFloatProperty(Self.Fields[intA]) do
        begin
          FieldByName(FieldName).AsFloat := CurrentValue;
        end;//with
      end;//if

      if Self.Fields[intA] is TIntegerProperty then
      begin
        with TIntegerProperty(Self.Fields[intA]) do
        begin
          FieldByName(FieldName).AsInteger := CurrentValue;
        end;//with
      end;//if

      if Self.Fields[intA] is TStringProperty then
      begin
        with TStringProperty(Self.Fields[intA]) do
        begin
          FieldByName(FieldName).AsString := CurrentValue;
        end;//with
      end;//if
    end;

    Post;
  end;//with

end;



end.
